;; test-parse.scm: parser test routines for r6rs-thrift
;; Copyright (C) 2012 Julian Graham

;; r6rs-thrift is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

#!r6rs

(import (rnrs))
(import (srfi :64))
(import (thrift compile parse))
(import (thrift compile tokenize))
(import (thrift private))

(define (mock-lexer . token-list)
  (define tokens token-list)
  (lambda ()
    (if (null? tokens)
	'*eoi*
	(let ((token (car tokens)))
	  (set! tokens (cdr tokens))
	  (if (pair? token)	      
	      (thriftc:make-lexical-token (car token) #f (cdr token))
	      (thriftc:make-lexical-token token #f #f))))))

(define (type-reference-equal? f1 f2)
  (and (thrift:type-reference? f1)
       (thrift:type-reference? f2)
       (equal? (thrift:type-reference-name f1)
	       (thrift:type-reference-name f2))
       (or (and (not (thrift:type-reference-descriptor f1))
		(not (thrift:type-reference-descriptor f2)))
	   (eq? (thrift:type-reference-descriptor f1)
		(thrift:type-reference-descriptor f2)))
       (or (and (not (thrift:type-reference-location f1))
		(not (thrift:type-reference-location f2)))
	   (equal? (thrift:type-reference-location f1)
		   (thrift:type-reference-location f2)))))

(define (const-value-equal? v1 v2) 
  (cond ((and (symbol? v1) (symbol? v2)) (eq? v1 v2))
	((or (and (boolean? v1) (boolean? v2))
	     (and (number? v1) (number? v2)))
	 (eqv? v1 v2))
	(else #f)))

(define (const-definition-equal? c1 c2)
  (and (thriftc:const-definition? c1)
       (thriftc:const-definition? c2)
       (equal? (thriftc:const-definition-name c1)
	       (thriftc:const-definition-name c2))
       (type-reference-equal? (thriftc:const-definition-type c1)
			      (thriftc:const-definition-type c2))
       (const-value-equal? (thriftc:const-definition-value c1)
			   (thriftc:const-definition-value c2))))

(define (struct-definition-equal? s1 s2)
  (and (thriftc:struct-definition? s1)
       (thriftc:struct-definition? s2)
       (equal? (thriftc:struct-definition-name s1)
	       (thriftc:struct-definition-name s2))
       (let loop ((fields1 (thriftc:struct-definition-fields s1))
		  (fields2 (thriftc:struct-definition-fields s2)))
	 (if (null? fields1)
	     (null? fields2)
	     (let ((field1 (car fields1))
		   (field2 (car fields2)))
	       (and (field-definition-equal? field1 field2)
		    (loop (cdr fields1) (cdr fields2))))))))

(define (field-definition-equal? f1 f2)
  (and (thriftc:field-definition? f1)
       (thriftc:field-definition? f2)
       (eq? (thriftc:field-definition-required? f1)
	    (thriftc:field-definition-required? f2))
       (type-reference-equal? (thriftc:field-definition-type f1)
			      (thriftc:field-definition-type f2))
       (equal? (thriftc:field-definition-name f1)
	       (thriftc:field-definition-name f2))
       (eqv? (thriftc:field-definition-ordinal f1)
	     (thriftc:field-definition-ordinal f2))))

(define (enum-value-definition-equal? v1 v2)
  (and (thriftc:enum-value-definition? v1)
       (thriftc:enum-value-definition? v2)
       (equal? (thriftc:enum-value-definition-name v1)
	       (thriftc:enum-value-definition-name v2))
       (eqv? (thriftc:enum-value-definition-ordinal v1)
	     (thriftc:enum-value-definition-ordinal v2))))

(define (enum-definition-equal? e1 e2)
  (and (thriftc:enum-definition? e1)
       (thriftc:enum-definition? e2)
       (equal? (thriftc:enum-definition-name e1)
	       (thriftc:enum-definition-name e2))
       (let loop ((values1 (thriftc:enum-definition-values e1))
		  (values2 (thriftc:enum-definition-values e2)))
	 (if (null? values1)
	     (null? values2)
	     (let ((value1 (car values1))
		   (value2 (car values2)))
	       (and (enum-value-definition-equal? value1 value2)
		    (loop (cdr values1) (cdr values2))))))))

(define (function-definition-equal? f1 f2)
  (and (thriftc:function-definition? f1)
       (thriftc:function-definition? f2)
       (equal? (thriftc:function-definition-name f1)
	       (thriftc:function-definition-name f2))
       (type-reference-equal? (thriftc:function-definition-return-type f1)
			      (thriftc:function-definition-return-type f2))
       (eqv? (thriftc:function-definition-oneway? f1)
	     (thriftc:function-definition-oneway? f2))
       (let loop ((arguments1 (thriftc:function-definition-arguments f1))
		  (arguments2 (thriftc:function-definition-arguments f2)))
	 (if (null? arguments1)
	     (null? arguments2)
	     (let ((argument1 (car arguments1))
		   (argument2 (car arguments2)))
	       (and (field-definition-equal? argument1 argument2)
		    (loop (cdr arguments1) (cdr arguments2))))))
       (let loop ((throws1 (thriftc:function-definition-throws f1))
		  (throws2 (thriftc:function-definition-throws f2)))
	 (if (null? throws1)
	     (null? throws2)
	     (let ((throw1 (car throws1))
		   (throw2 (car throws2)))
	       (and (field-definition-equal? throw1 throw2)
		    (loop (cdr throws1) (cdr throws2))))))))

(define (service-definition-equal? s1 s2)
  (and (thriftc:service-definition? s1)
       (thriftc:service-definition? s2)
       (equal? (thriftc:service-definition-name s1)
	       (thriftc:service-definition-name s2))
       (let loop ((functions1 (thriftc:service-definition-functions s1))
		  (functions2 (thriftc:service-definition-functions s2)))
	 (if (null? functions1)
	     (null? functions2)
	     (let ((function1 (car functions1))
		   (function2 (car functions2)))
	       (and (function-definition-equal? function1 function2)
		    (loop (cdr functions1) (cdr functions2))))))))

(define (thrift-definition-equal? t1 t2)
  (and (thriftc:thrift? t1)
       (thriftc:thrift? t2)
       (let loop ((definitions1 (thriftc:thrift-definitions t1))
		  (definitions2 (thriftc:thrift-definitions t2)))
	 (if (null? definitions1)
	     (null? definitions2)
	     (let ((definition1 (car definitions1))
		   (definition2 (car definitions2)))
	       (cond ((and (thriftc:const-definition? definition1)
			   (thriftc:const-definition? definition2))
		      (and (const-definition-equal? definition1 definition2)
			   (loop (cdr definitions1) (cdr definitions2))))
		     ((and (thriftc:struct-definition? definition1)
			   (thriftc:struct-definition? definition2))
		      (and (struct-definition-equal? definition1 definition2)
			   (loop (cdr definitions1) (cdr definitions2))))
		     ((and (thriftc:enum-definition? definition1)
			   (thriftc:enum-definition? definition2))
		      (and (enum-definition-equal? definition1 definition2)
			   (loop (cdr definitions1) (cdr definitions2))))
		     ((and (thriftc:service-definition? definition1)
			   (thriftc:service-definition? definition2))
		      (and (service-definition-equal? definition1 definition2)
			   (loop (cdr definitions1) (cdr definitions2))))
		     (else #f)))))))

(test-begin "parse")
(test-begin "simple")

(test-group "namespace"
  (let* ((p ((thriftc:make-parser 
	      (mock-lexer 'NAMESPACE 'STAR '(IDENTIFIER . "foo")))))
	 (q (thriftc:make-namespace #f "foo")))
    (test-assert 
     (thrift-definition-equal? (thriftc:make-thrift (list q) '() '()) p))))

(test-group "const"
  (let* ((p ((thriftc:make-parser
	      (mock-lexer 'CONST 'BOOL '(IDENTIFIER . "foo") 'EQUAL 'TRUE))))
	 (q (thriftc:make-const-definition 
	     "foo" (thrift:make-type-reference 
		    "bool" #f thrift:field-type-bool) #t)))
    (test-assert
     (thrift-definition-equal? (thriftc:make-thrift '() '() (list q)) p))))

(test-group "struct"
  (let* ((p ((thriftc:make-parser 
	      (mock-lexer 'STRUCT '(IDENTIFIER . "Foo") 'LBRACE 'RBRACE))))
	 (q (thriftc:make-struct-definition "Foo" '())))
    (test-assert
     (thrift-definition-equal? (thriftc:make-thrift '() '() (list q)) p))))

(test-group "enum"
  (let* ((p ((thriftc:make-parser 
	      (mock-lexer 'ENUM '(IDENTIFIER . "Foo") 'LBRACE 'RBRACE))))
	 (q (thriftc:make-enum-definition "Foo" '())))
    (test-assert
     (thrift-definition-equal? (thriftc:make-thrift '() '() (list q)) p))))

(test-end "simple")
(test-begin "enum")

(test-group "values"
  (let* ((p ((thriftc:make-parser
	      (mock-lexer 'ENUM '(IDENTIFIER . "Foo") 'LBRACE
			  '(IDENTIFIER . "FOO") 'EQUAL '(NUM-INTEGER . 1)
			  'SEMICOLON 'RBRACE)))))
    (test-assert p)))

(test-end "enum")
